home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / ENTERPRS / C64 / BBS / EBBS64V3.ARC / REL FILE COPY (.txt) < prev   
Commodore BASIC  |  2000-06-30  |  4KB  |  140 lines
  1. 1 REM BY JIM MCANDREW
  2. 10 POKE56,26:CLR:RUN11
  3. 11 PRINTCHR$(142)CHR$(147)SPC(14)" REL-COPY [146]":PRINT
  4. 14 PRINTSPC(14)"[206][165]":PRINTSPC(10)"BY  [205][204][186][204][206][205][206][205][164]":PRINTSPC(14)"[206][165]":PRINTSPC(14)"[205][165]"SPC(8)"(R)"
  5. 15 Z$=CHR$(0):P=256:DIMBY(17)
  6. 19 READML$:INSUBML=PEEK(65)+PEEK(66)*P+7:READML$:OUTSUBML=PEEK(65)+PEEK(66)*P+7
  7. 20 READML$:DISABLE WEDGE=PEEK(65)+PEEK(66)*P+7
  8. 30 PRINT" SINGLE FILE- SINGLE/DUAL DISK TRANSFER"
  9. 31 PRINT"      FOR RELATIVE FILES (ONLY!)"
  10. 33 IFPEEK(124)=76THENPRINTSPC(10)" WEDGE DISABLED [146]":SYS DISABLE:W=1
  11. 35 PRINT" DRIVE#: FROM,TO    8,8[157][157][157][157][157]";:INPUTDS,DD:D=DS
  12. 36 OPEN15,D,15:CLOSE15:IFST<0THENPRINT" DEVICE#"D" NOT PRESENT[146]":GOTO35
  13. 37 IFD=DSTHENIFDS<>DDTHEND=DD:GOTO36
  14. 40 GOSUB150:GOSUB200:IFENTHEN40
  15. 45 IFENTHEN40
  16. 50 TF=T:SF=S:RL=BY(3):NB=BC:RN=INT((NB*254)/BY(3)):RL=BY(3):RC=0
  17. 60 GOSUB600
  18. 65 GOSUB700
  19. 66 GOSUB800:IFEFTHENEF=0:GOTO65
  20. 67 GOSUB855
  21. 70 D=DD:GOSUB220:IFENTHEN70
  22. 75 TW=T:SW=S:GOSUB940:IFEFTHEN95
  23. 80 IFAFTHENGOSUB140:GOSUB600:GOSUB680:GOSUB950
  24. 90 IFAFTHEN80
  25. 91 PRINT"      COMPLETE[146]":IFNB>232THEN95
  26. 92 PRINT" W[146] WRITE THIS FILE AGAIN":PRINT" E[146] END"
  27. 93 GOSUB170:IFAN$="W"THENPF=0:GOTO65
  28. 94 IFAN$<>"E"THEN93
  29. 95 POKE56,160:IFWTHEN100
  30. 99 END
  31. 100 IFNB>179THEN110
  32. 105 IFPEEK(52224)=76ANDPEEK(52226)=204THENSYS52224:END
  33. 110 PRINT" CAN'T REWEDGE":END
  34. 140 IFDS<>DDTHENIFPFTHENRETURN
  35. 149 :
  36. 150 REM**GET SOURCE DISK READY**
  37. 151 :
  38. 155 PRINT"    SOURCE DISK MUST BE PRESENT":D=DS
  39. 160 PRINT"   IN DRIVE#"D"FOR NEXT STEP..."
  40. 165 PRINT"     PRESS ANY KEY WHEN READY"
  41. 170 FORX=1TO10:GETAN$:NEXT
  42. 175 GETAN$:IFAN$=""THEN175
  43. 180 RETURN
  44. 199 :
  45. 200 REM ** READ REL FILE SPEC.S
  46. 201 :
  47. 205 PRINT:INPUT"NAM*";NA$
  48. 210 PRINT"   READING FILE SPEC.S... "
  49. 220 OPEN15,D,15,"I":GOSUB8000:IFENTHENCLOSE15:GOTO220
  50. 225 OPEN8,D,8,NA$:GOSUB8000:IFENTHENCLOSE8:CLOSE15:RETURN
  51. 230 PRINT#15,"M-R"CHR$(24)CHR$(0)CHR$(2):GET#15,TR$,SC$:CLOSE8
  52. 240 TR=ASC(TR$+Z$):SC=ASC(SC$+Z$):OPEN8,D,8,"#":BC=0
  53. 245 PRINT#15,"U1:"8;0;TR;SC:GOSUB8000:IFENTHEN245
  54. 250 FORX=0TO17:GET#8,BY$:BY(X)=ASC(BY$+Z$):NEXT
  55. 255 IFBY(2)=0THENT=BY(16):S=BY(17)
  56. 260 IFBY(0)=0THEN280
  57. 265 FORX=6TO14STEP2
  58. 270 IFNOTBY(2)THENIFBY(X)THENBC=BC+120:TR=BY(X):SC=BY(X+1)
  59. 275 NEXT:GOTO245
  60. 280 BC=BC+(BY(1)-15)/2:CLOSE8:CLOSE15:RETURN
  61. 290 CLOSE8:CLOSE15:RETURN
  62. 599 :
  63. 600 REM READ BLOCK CHAIN
  64. 601 :
  65. 605 POKE253,0:POKE254,26:PRINT"   READING FILE DATA... [146]"
  66. 610 OPEN15,DS,15,"I":GOSUB8000:IFENTHENCLOSE15:GOTO610
  67. 615 OPEN8,DS,8,"#":GOSUB8000:IFENTHENCLOSE8:CLOSE15:GOTO610
  68. 620 BN=0:AF=0:T=TF:S=SF:PRINT
  69. 625 PRINT#15,"U1:"8;0;T;S:GOSUB8000:IFENTHEN625
  70. 626 PRINT" BLOCK#    [157][157][157][157]";RC+BN+1:PRINT"[145]";
  71. 630 GET#8,T$,S$:T=ASC(T$+Z$):S=ASC(S$+Z$)
  72. 635 SYS INSUBML
  73. 640 BN=BN+1:IFBN=231THENIFT<>0THENAF=1:GOTO655
  74. 645 IFT=0THEN655
  75. 650 GOTO625
  76. 655 CLOSE15:CLOSE8:TF=T:SF=S:RC=RC+BN:RETURN
  77. 679 :
  78. 680 REM PREPARE OUTPUT DISK
  79. 681 :
  80. 685 IFDS<>DDTHENIFPFTHENRETURN
  81. 700 PRINT" DESTINATION DISK MUST BE PRESENT":D=DD:GOTO160
  82. 799 :
  83. 800 REM CHECK DISK SPACE
  84. 801 :
  85. 805 PRINT"   CHECKING DISK SPACE... [146]";:EF=0
  86. 810 OPEN15,DD,15,"I":GOSUB8000:IFENTHENCLOSE15:GOTO810
  87. 815 PRINT#15,"M-R"CHR$(250)CHR$(2)CHR$(3):GET#15,F$,G$,G$
  88. 820 BF=(P*ASC(G$+Z$)+ASC(F$+Z$))
  89. 825 IFBF>=NB-1*INT(-NB/120)THENPRINT"O.K.[146]":CLOSE15:RETURN
  90. 830 PRINT:PRINTSPC(5)" NOT ENOUGH ROOM ON THIS DISK [146]":CLOSE15:EF=1:RETURN
  91. 849 :
  92. 851 :
  93. 855 REM CREATE REL FILE
  94. 856 :
  95. 860 PRINT:PRINT"NAME   ";NA$:PRINT"[145]";:INPUTNA$
  96. 861 IFRIGHT$(NA$,1)="*"THENPRINT"SORRY,=>* NOT ALLOWED IN FILE NAME":GOTO860
  97. 865 OPEN15,DD,15,"I":GOSUB8000:IFENTHEN865
  98. 866 PRINT"    CREATING RELATIVE FILE...[146]"
  99. 870 OPEN8,DD,8,NA$+",L,"+CHR$(RL):GOSUB8000:IFENTHENCLOSE8:CLOSE15:GOTO860
  100. 872 HB=INT(RN/256):LB=RN-HB*256:WC=0
  101. 875 PRINT#15,"P"CHR$(8)CHR$(LB)CHR$(HB):OK=50:GOSUB8000:OK=0:IFENTHEN875
  102. 878 PRINT#8,"":OK=50:GOSUB8000:OK=0:IFENTHEN875
  103. 880 CLOSE8:CLOSE15:RETURN
  104. 940 IFBC<>NBTHENPRINT" ERROR FILE LENGTH MISMATCH.. ABORTED[146]":EF=1:RETURN
  105. 945 PRINT"  FILE CREATED,";:PF=1
  106. 946 :
  107. 947 REM WRITE DATA
  108. 948 :
  109. 950 IFPFTHENPRINT:PRINT
  110. 951 PRINT" WRITING DATA...[146]":PF=1
  111. 955 POKE253,0:POKE254,26:T=TW:S=SW:CN=0
  112. 960 OPEN15,DD,15,"I":GOSUB8000:IFENTHEN960
  113. 965 OPEN8,DD,8,"#":GOSUB8000:IFENTHENCLOSE8:GOTO965
  114. 970 PRINT#15,"U1:"8;0;T;S:GOSUB8000:IFENTHEN970
  115. 975 GET#8,TW$,SW$:TW=ASC(TW$+Z$):SW=ASC(SW$+Z$)
  116. 980 SYS OUTSUBML
  117. 985 PRINT#15,"U2:"8;0;T;S:GOSUB8000:IFENTHEN985
  118. 990 CN=CN+1
  119. 992 PRINT" BLOCK#    [157][157][157][157]";WC+CN:PRINT"[145]";
  120. 995 T=TW:S=SW:IFT=0THEN999
  121. 996 IFCN=231THEN999
  122. 998 GOTO970
  123. 999 CLOSE8:CLOSE15:WC=WC+CN:RETURN
  124. 7997 :
  125. 7998 REM CHECK DISK ERROR CHANEL
  126. 7999 :
  127. 8000 INPUT#15,EN,EM$,ET,ES:IFEN=0THENRETURN
  128. 8005 IFOKTHENIFEN=OKTHENEN=0:OK=0:RETURN
  129. 8010 PRINT:PRINT" DISK ERROR[146]=>"EN;EM$;ET;ES:PRINT:PRINT" TRY AGAIN? Y/N
  130. 8020 [141]170
  131. 8030 [139]AN$[178]"Y"[167][142]
  132. 8040 [139]AN$[179][177]"N"[167]8020
  133. 8050 [160]8:[160]15:[137]95
  134. 8800 [143]             *** CAUTION ***  
  135. 8891 [143] THESE DATA STATEMENTS CANNOT BE ALTERED OR REENTERED FROM THE KEYBOARD!
  136. 9000 [131]"THROW AWAY"
  137. 9020 [131]"STEPINPUTNEW ASC(null)CLOSE(null)LEFT$ASC FN(null)xASCASCON(null)(null)(null)X(null)(null)(null)(null)(null)(null)(null)(null)(null)L(null)(null)XXX"
  138. 9040 [131]"STEPINPUTNEW RIGHT$(null)CLOSE(null)LEFT$ASCxASCASC>(null)(null)(null)X NOT(null)(null)(null)(null)(null)(null)(null)(null)(null)(null)L(null)(null)XXX"
  139. 9060 [131]"NEWEXP-(null)VERIFY|MID$(null)`"
  140.